home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / COMPILER / LYSRC / YACC.Y < prev    next >
Text File  |  1993-01-23  |  22KB  |  812 lines
  1.  
  2. /* YACC.Y: Yacc grammar for Yacc main program. 2-17-91, 4-30-91 AG
  3.    To bootstrap Yacc, use Yacc iself to compile this grammar, then
  4.    run tpc on the generated program.
  5.  
  6.    Note:
  7.  
  8.    This is not entirely the `official' syntax introduced by Johnson, but it
  9.    should be compatible with UNIX Yacc (except for the differences specified
  10.    in the program header, below), as described in the UNIX manual, including
  11.    the language elements entitled as "old features supported but not
  12.    encouraged."
  13.  
  14.    Bugs:
  15.  
  16.    - Processes $$'s, $i's, %} and } inside of comments in Turbo Pascal code
  17.      (instead of ignoring them).
  18.  
  19.    Shift/reduce conflicts:
  20.  
  21.    This grammar will produce a number of shift/reduce conflicts caused by
  22.    the error productions, since it does not specify unambigiously whether
  23.    errors are to be handled in global structures (definitions and rules)
  24.    or by enclosed syntactic constructs (e.g. symbols). Yacc will resolve
  25.    these conflicts in favour of shift, which is o.k. (it means that
  26.    errors will be caught in the innermost constructs with error handling,
  27.    thus reducing the amount of skipped symbols in resynchronization).
  28.  
  29.    Error handling is done using the general method of Schreiner/Friedman
  30.    (see Schreiner/Friedman, "Introduction to compiler construction with
  31.    UNIX," 1985).
  32.  
  33. */
  34.  
  35. %{
  36.  
  37. {$X+}
  38. program Yacc;
  39.  
  40. (* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
  41.    6509 Schornsheim/Germany
  42.    All rights reserved *)
  43.  
  44. uses YaccLib, YaccBase, YaccMsgs, YaccSem, YaccTables, YaccParseTable;
  45.  
  46. (* TP Yacc - Yet Another Compiler Compiler for MS-DOS/Turbo Pascal
  47.  
  48.    Version 3.0 as of April 91
  49.    Version 3.0a as of May 92 (bug fixes in precedence and type information
  50.      updates)
  51.  
  52.    Author
  53.  
  54.    Albert Graef
  55.    Schillerstr. 18
  56.    6509 Schornsheim/Germany
  57.  
  58.    Graef@DMZRZU71.bitnet
  59.  
  60.    Synopsis   YACC [options] yacc-file[.Y] [output-file[.PAS]]
  61.  
  62.    Options
  63.  
  64.    /v  "Verbose:" Yacc generates a readable description of the generated
  65.        parser, written to yacc-file with new extension .LST.
  66.  
  67.    /d  "Debug:" Yacc generates parser with debugging output.
  68.  
  69.    Description
  70.  
  71.    This is a reimplementation of the popular UNIX compiler generator
  72.    Yacc for MS-DOS and Turbo Pascal.
  73.  
  74.    Differences from UNIX Yacc:
  75.  
  76.    - Produces output code for Turbo Pascal, rather than for C.
  77.  
  78.    - Does not support %union definitions. Instead, a value type is declared
  79.      by specifying the type identifier *itself* as the tag of a %token
  80.      or %type definition. Yacc will automatically generate an appropriate
  81.      yylval variable of a variant record type (YYSType) which is capable of
  82.      holding values of any of the types used in %token and %type.
  83.  
  84.      Type checking is *very* strict. If you use type definitions, then
  85.      any symbol referred to in an action *must* have a type introduced
  86.      in a type definition. Either the symbol must have been assigned a
  87.      type in the definitions section, or the $<type-identifier> notation
  88.      must be used. The syntax of the %type definition has been changed
  89.      slightly to allow definitions of the form
  90.        %type <type-identifier>
  91.      (omitting the nonterminals) which may be used to declare types which
  92.      are not assigned to any grammar symbol, but are used with the
  93.      $<...> construct.
  94.  
  95.    - The parse tables constructed by this Yacc version are slightly greater
  96.      than those constructed by UNIX Yacc, since a reduce action will only be
  97.      chosen as the default action if it is the *only* action in the state.
  98.      In difference, UNIX Yacc chooses a reduce action as the default action
  99.      whenever it is the only *reduce* action of the state (even if there are
  100.      other shift actions).
  101.  
  102.      This solves a bug in UNIX Yacc that makes the generated parser start
  103.      error recovery too late with certain types of error productions (see
  104.      also Schreiner/Friedman, "Introduction to compiler construction with
  105.      UNIX," 1985). Also, errors will be caught sooner in most cases where
  106.      standard Yacc would carry out an additional (default) reduction before
  107.      detecting the error.
  108.  
  109. *)
  110.  
  111. %}
  112.  
  113. /* Lexical part of the Yacc language: */
  114.  
  115. %token
  116.   ID        /* identifiers: {letter}{letter_or_digit}* */
  117.   C_ID        /* identifier which forms left side of rule, i.e. is
  118.            followed by a colon */
  119.   LITERAL       /* single character literal */
  120.   LITID         /* multiple character literal */
  121.   NUMBER    /* nonnegative integers: {digit}+ */
  122.   PTOKEN PLEFT PRIGHT PNONASSOC PTYPE PSTART PPREC
  123.           /* reserved words: PTOKEN=%token, etc. */
  124.   PP        /* source sections separator %% */
  125.   LCURL        /* curly braces: %{ and %} */
  126.   RCURL
  127.   ',' ':' ';' '|' '{' '}' '<' '>' '='
  128.         /* literals */
  129.   ILLEGAL    /* illegal input character */
  130.  
  131. %start grammar
  132.  
  133. %%
  134.  
  135. /* Lexical entities, those that may give rise to syntax errors are augmented
  136.    with error productions, and important symbols call yyerrok. */
  137.  
  138. id        : ID
  139. c_id        : C_ID
  140. literal         : LITERAL
  141. litid           : LITID
  142. number        : NUMBER
  143. ptoken        : PTOKEN        { yyerrok; }
  144. pleft        : PLEFT            { yyerrok; }
  145. pright        : PRIGHT        { yyerrok; }
  146. pnonassoc    : PNONASSOC    { yyerrok; }
  147. ptype        : PTYPE            { yyerrok; }
  148. pstart        : PSTART        { yyerrok; }
  149. pprec        : PPREC
  150. pp        : PP            { yyerrok; }
  151. lcurl        : LCURL
  152. rcurl        : RCURL
  153.         | error            { error(rcurl_expected); }
  154. comma        : ','
  155. colon        : ':'            { yyerrok; }
  156. semicolon    : ';'            { yyerrok; }
  157. bar        : '|'            { yyerrok; }
  158. lbrace        : '{'
  159. rbrace        : '}'
  160.         | error            { error(rbrace_expected); }
  161. langle        : '<'
  162. rangle        : '>'
  163.         | error         { error(rangle_expected); }
  164. eq        : '='
  165.  
  166. /* Syntax and semantic routines: */
  167.  
  168. grammar        : defs pp
  169.                   { sort_types;
  170.                                   definitions;
  171.                                   next_section; }
  172.           rules
  173.                   { next_section;
  174.                                   generate_parser;
  175.                                   next_section; }
  176.           aux_procs
  177.         ;
  178.  
  179. aux_procs    : /* empty: aux_procs is optional */
  180.  
  181.         | pp { copy_rest_of_file; }
  182.  
  183.         ;
  184.  
  185.  
  186. defs        : /* empty */
  187.         | defs def    { yyerrok; }
  188.         | defs error    { error(error_in_def); }
  189.         ;
  190.  
  191. def        : pstart id
  192.                  { startnt := ntsym($2); }
  193.         | pstart error
  194.                 { error(ident_expected); }
  195.         | lcurl { copy_code; } rcurl
  196.  
  197.         | ptoken
  198.                 { act_prec := 0; }
  199.           tag token_list
  200.  
  201.         | pleft
  202.                 { act_prec := new_prec_level(left); }
  203.           tag token_list
  204.  
  205.         | pright
  206.                 { act_prec := new_prec_level(right); }
  207.           tag token_list
  208.  
  209.         | pnonassoc
  210.                 { act_prec := new_prec_level(nonassoc); }
  211.           tag token_list
  212.  
  213.         | ptype tag nonterm_list
  214.  
  215.                 | ptype tag
  216.  
  217.         ;
  218.  
  219. tag        : /* empty: type tag is optional */
  220.                 { act_type := 0; }
  221.         | langle id rangle
  222.                 { act_type := $2; add_type($2); }
  223.         ;
  224.  
  225. token_list    : token_num
  226.  
  227.         | token_list token_num
  228.                 { yyerrok; }
  229.         | token_list comma token_num
  230.                 { yyerrok; }
  231.         | error
  232.                 { error(ident_expected); }
  233.         | token_list error
  234.                 { error(error_in_def); }
  235.         | token_list comma error
  236.                 { error(ident_expected); }
  237.         ;
  238.  
  239. token_num    : literal
  240.                 { if act_type<>0 then
  241.                                     sym_type^[$1] := act_type;
  242.                                   if act_prec<>0 then
  243.                                     sym_prec^[$1] := act_prec; }
  244.                    | litid
  245.                 { litsym($1, 0);
  246.                                   if act_type<>0 then
  247.                                     sym_type^[litsym($1, 0)] := act_type;
  248.                                   if act_prec<>0 then
  249.                                     sym_prec^[litsym($1, 0)] := act_prec; }
  250.                    | id
  251.                 { litsym($1, 0);
  252.                                   if act_type<>0 then
  253.                                     sym_type^[litsym($1, 0)] := act_type;
  254.                                   if act_prec<>0 then
  255.                                     sym_prec^[litsym($1, 0)] := act_prec; }
  256.                    | litid number
  257.                 { litsym($1, 0);
  258.                                   if act_type<>0 then
  259.                                     sym_type^[litsym($1, $2)] := act_type;
  260.                                   if act_prec<>0 then
  261.                                     sym_prec^[litsym($1, 0)]  := act_prec; }
  262.                    | id number
  263.                 { litsym($1, 0);
  264.                                   if act_type<>0 then
  265.                                     sym_type^[litsym($1, $2)] := act_type;
  266.                                   if act_prec<>0 then
  267.                                     sym_prec^[litsym($1, 0)]  := act_prec; }
  268.         ;
  269.  
  270. nonterm_list    : nonterm
  271.         | nonterm_list nonterm
  272.                 { yyerrok; }
  273.         | nonterm_list comma nonterm
  274.                 { yyerrok; }
  275.         | error
  276.                 { error(ident_expected); }
  277.         | nonterm_list error
  278.                 { error(error_in_def); }
  279.         | nonterm_list comma error
  280.                 { error(ident_expected); }
  281.         ;
  282.  
  283. nonterm        : id
  284.                 { if act_type<>0 then
  285.                                     sym_type^[ntsym($1)] := act_type; }
  286.         ;
  287.  
  288.  
  289. rules        :         { next_section; }
  290.           rule1
  291.  
  292.         | lcurl { copy_code; } rcurl
  293.                 { next_section; }
  294.           rule1
  295.                     /* rules section may be prefixed
  296.                        with `local' Turbo Pascal
  297.                        declarations */
  298.         | rules rule
  299.                 { yyerrok; }
  300.         | error
  301.                 { error(error_in_rule); }
  302.         | rules error
  303.                 { error(error_in_rule); }
  304.         ;
  305.  
  306. rule1        : c_id
  307.                 { start_rule(ntsym($1)); }
  308.           colon
  309.                   { start_body; }
  310.           body prec
  311.                 { end_body; }
  312.         ;
  313.  
  314. rule        : rule1
  315.  
  316.         | bar
  317.                 { start_body; }
  318.           body prec
  319.                 { end_body; }
  320.         ;
  321.  
  322. body        : /* empty */
  323.  
  324.         | body literal
  325.                 { add_symbol($2); yyerrok; }
  326.         | body litid
  327.                 { add_symbol(sym($2)); yyerrok; }
  328.         | body id
  329.                 { add_symbol(sym($2)); yyerrok; }
  330.                 | body action
  331.                 { add_action; yyerrok; }
  332.         | body error
  333.                 { error(error_in_rule); }
  334.         ;
  335.  
  336. action        : lbrace { copy_action; } rbrace
  337.  
  338.         | eq { copy_single_action; }
  339.                         /* old language feature; code must be
  340.                    single statement ending with `;' */
  341.         ;
  342.  
  343. prec        : /* empty */
  344.  
  345.         | pprec literal
  346.                 { add_rule_prec($2); }
  347.           opt_action
  348.  
  349.         | pprec litid
  350.                 { add_rule_prec(litsym($2, 0)); }
  351.           opt_action
  352.  
  353.         | pprec id
  354.                 { add_rule_prec(litsym($2, 0)); }
  355.           opt_action
  356.  
  357.         | prec semicolon
  358.  
  359.         ;
  360.  
  361. opt_action    : /* empty */
  362.  
  363.         | action
  364.                 { add_action; }
  365.         ;
  366.  
  367.  
  368. %%
  369.  
  370. (* Lexical analyzer (implemented in Turbo Pascal for maximum efficiency): *)
  371.  
  372. function yylex : integer;
  373.   function end_of_input : boolean;
  374.     begin
  375.       end_of_input := (cno>length(line)) and eof(yyin)
  376.     end(*end_of_input*);
  377.   procedure scan;
  378.     (* scan for nonempty character, skip comments *)
  379.     procedure scan_comment;
  380.       var p : integer;
  381.       begin
  382.         p := pos('*/', copy(line, cno, length(line)));
  383.         if p>0 then
  384.           cno := cno+succ(p)
  385.         else
  386.           begin
  387.             while (p=0) and not eof(yyin) do
  388.               begin
  389.                 readln(yyin, line);
  390.                 inc(lno);
  391.                 p := pos('*/', line)
  392.               end;
  393.             if p=0 then
  394.               begin
  395.                 cno := succ(length(line));
  396.                 error(open_comment_at_eof);
  397.               end
  398.             else
  399.               cno := succ(succ(p))
  400.           end
  401.       end(*scan_comment*);
  402.     begin
  403.       while not end_of_input do
  404.         if cno<=length(line) then
  405.           case line[cno] of
  406.             ' ', tab : inc(cno);
  407.             '/' :
  408.               if (cno<length(line)) and (line[succ(cno)]='*') then
  409.                 begin
  410.                   inc(cno, 2);
  411.                   scan_comment
  412.                 end
  413.               else
  414.                 exit
  415.             else
  416.               exit
  417.           end
  418.         else
  419.           begin
  420.             readln(yyin, line);
  421.             inc(lno); cno := 1;
  422.           end
  423.     end(*scan*);
  424.   function scan_ident : integer;
  425.     (* scan an identifier *)
  426.     var
  427.       idstr : String;
  428.     begin
  429.       idstr := line[cno];
  430.       inc(cno);
  431.       while (cno<=length(line)) and (
  432.             ('A'<=upCase(line[cno])) and (upCase(line[cno])<='Z') or
  433.             ('0'<=line[cno]) and (line[cno]<='9') or
  434.             (line[cno]='_') or
  435.             (line[cno]='.') ) do
  436.     begin
  437.       idstr := idstr+line[cno];
  438.       inc(cno)
  439.     end;
  440.       yylval := get_key(idstr);
  441.       scan;
  442.       if not end_of_input and (line[cno]=':') then
  443.         scan_ident := C_ID
  444.       else
  445.         scan_ident := ID
  446.     end(*scan_ident*);
  447.   function scan_literal: integer;
  448.     (* scan a literal, i.e. string *)
  449.     var
  450.       idstr : String;
  451.       oct_val : Byte;
  452.     begin
  453.       idstr := line[cno];
  454.       inc(cno);
  455.       while (cno<=length(line)) and (line[cno]<>idstr[1]) do
  456.         if line[cno]='\' then
  457.           if cno<length(line) then
  458.             begin
  459.               inc(cno);
  460.               case line[cno] of
  461.                 'n' :
  462.                   begin
  463.                     idstr := idstr+nl;
  464.                     inc(cno)
  465.                   end;
  466.                 'r' :
  467.                   begin
  468.                     idstr := idstr+cr;
  469.                     inc(cno)
  470.                   end;
  471.                 't' :
  472.                   begin
  473.                     idstr := idstr+tab;
  474.                     inc(cno)
  475.                   end;
  476.                 'b' :
  477.                   begin
  478.                     idstr := idstr+bs;
  479.                     inc(cno)
  480.                   end;
  481.                 'f' :
  482.                   begin
  483.                     idstr := idstr+ff;
  484.                     inc(cno)
  485.                   end;
  486.                 '0'..'7' :
  487.                   begin
  488.                     oct_val := ord(line[cno])-ord('0');
  489.                     inc(cno);
  490.                     while (cno<=length(line)) and
  491.                           ('0'<=line[cno]) and
  492.                           (line[cno]<='7') do
  493.                       begin
  494.                         oct_val := oct_val*8+ord(line[cno])-ord('0');
  495.                         inc(cno)
  496.                       end;
  497.                     idstr := idstr+chr(oct_val)
  498.                   end
  499.                 else
  500.                   begin
  501.                     idstr := idstr+line[cno];
  502.                     inc(cno)
  503.                   end
  504.               end
  505.             end
  506.           else
  507.             inc(cno)
  508.         else
  509.           begin
  510.             idstr := idstr+line[cno];
  511.             inc(cno)
  512.           end;
  513.       if cno>length(line) then
  514.         error(missing_string_terminator)
  515.       else
  516.         inc(cno);
  517.       if length(idstr)=2 then
  518.         begin
  519.           yylval := ord(idstr[2]);
  520.           scan_literal := LITERAL;
  521.         end
  522.       else if length(idstr)>1 then
  523.         begin
  524.           yylval := get_key(''''+copy(idstr, 2, pred(length(idstr)))+'''');
  525.           scan_literal := LITID;
  526.         end
  527.       else
  528.         scan_literal := ILLEGAL;
  529.     end(*scan_literal*);
  530.   function scan_num : integer;
  531.     (* scan an unsigned integer *)
  532.     var
  533.       numstr : String;
  534.       code : integer;
  535.     begin
  536.       numstr := line[cno];
  537.       inc(cno);
  538.       while (cno<=length(line)) and
  539.             ('0'<=line[cno]) and (line[cno]<='9') do
  540.         begin
  541.           numstr := numstr+line[cno];
  542.           inc(cno)
  543.         end;
  544.       val(numstr, yylval, code);
  545.       if code=0 then
  546.         scan_num := NUMBER
  547.       else
  548.         scan_num := ILLEGAL;
  549.     end(*scan_num*);
  550.   function scan_keyword : integer;
  551.     (* scan %xy *)
  552.     function lookup(key : String; var tok : integer) : boolean;
  553.       (* table of Yacc keywords (unstropped): *)
  554.       const
  555.         no_of_entries = 11;
  556.         max_entry_length = 8;
  557.         keys : array [1..no_of_entries] of String[max_entry_length] = (
  558.           '0', '2', 'binary', 'left', 'nonassoc', 'prec', 'right',
  559.           'start', 'term', 'token', 'type');
  560.         toks : array [1..no_of_entries] of integer = (
  561.           PTOKEN, PNONASSOC, PNONASSOC, PLEFT, PNONASSOC, PPREC, PRIGHT,
  562.           PSTART, PTOKEN, PTOKEN, PTYPE);
  563.       var m, n, k : integer;
  564.       begin
  565.         (* binary search: *)
  566.         m := 1; n := no_of_entries;
  567.         lookup := true;
  568.         while m<=n do
  569.           begin
  570.             k := m+(n-m) div 2;
  571.             if key=keys[k] then
  572.               begin
  573.                 tok := toks[k];
  574.                 exit
  575.               end
  576.             else if key>keys[k] then
  577.               m := k+1
  578.             else
  579.               n := k-1
  580.           end;
  581.         lookup := false
  582.       end(*lookup*);
  583.     var
  584.       keywstr : String;
  585.       tok : integer;
  586.     begin
  587.       inc(cno);
  588.       if cno<=length(line) then
  589.         case line[cno] of
  590.           '<' :
  591.             begin
  592.               scan_keyword := PLEFT;
  593.               inc(cno)
  594.             end;
  595.           '>' :
  596.             begin
  597.               scan_keyword := PRIGHT;
  598.               inc(cno)
  599.             end;
  600.           '=' :
  601.             begin
  602.               scan_keyword := PPREC;
  603.               inc(cno)
  604.             end;
  605.           '%', '\' :
  606.             begin
  607.               scan_keyword := PP;
  608.               inc(cno)
  609.             end;
  610.           '{' :
  611.             begin
  612.               scan_keyword := LCURL;
  613.               inc(cno)
  614.             end;
  615.           '}' :
  616.             begin
  617.               scan_keyword := RCURL;
  618.               inc(cno)
  619.             end;
  620.           'A'..'Z', 'a'..'z', '0'..'9' :
  621.             begin
  622.               keywstr := line[cno];
  623.               inc(cno);
  624.               while (cno<=length(line)) and (
  625.                     ('A'<=upCase(line[cno])) and (upCase(line[cno])<='Z') or
  626.                     ('0'<=line[cno]) and (line[cno]<='Z') ) do
  627.                 begin
  628.                   keywstr := keywstr+line[cno];
  629.                   inc(cno)
  630.                 end;
  631.               if lookup(keywstr, tok) then
  632.                 scan_keyword := tok
  633.               else
  634.                 scan_keyword := ILLEGAL
  635.             end;
  636.           else scan_keyword := ILLEGAL
  637.         end
  638.       else
  639.         scan_keyword := ILLEGAL;
  640.     end(*scan_keyword*);
  641.   function scan_char : integer;
  642.     (* scan any single character *)
  643.     begin
  644.       scan_char := ord(line[cno]);
  645.       inc(cno)
  646.     end(*scan_char*);
  647.   var lno0, cno0 : integer;
  648.   begin
  649.     tokleng := 0;
  650.     scan;
  651.     lno0 := lno; cno0 := cno;
  652.     if end_of_input then
  653.       yylex := 0
  654.     else
  655.       case line[cno] of
  656.         'A'..'Z', 'a'..'z', '_' : yylex := scan_ident;
  657.     '''', '"' : yylex := scan_literal;
  658.     '0'..'9' : yylex := scan_num;
  659.     '%', '\' : yylex := scan_keyword;
  660.         '=' :
  661.           if (cno<length(line)) and (line[succ(cno)]='{') then
  662.             begin
  663.               inc(cno);
  664.               yylex := scan_char
  665.             end
  666.           else
  667.             yylex := scan_char;
  668.     else yylex := scan_char;
  669.       end;
  670.     if lno=lno0 then
  671.       tokleng := cno-cno0
  672.   end(*yylex*);
  673.  
  674. (* Main program: *)
  675.  
  676. var i : Integer;
  677.  
  678. begin
  679.  
  680.   (* sign-on: *)
  681.  
  682.   writeln(sign_on);
  683.  
  684.   (* parse command line: *)
  685.  
  686.   if paramCount=0 then
  687.     begin
  688.       writeln(usage);
  689.       writeln(options);
  690.       halt(0);
  691.     end;
  692.  
  693.   yfilename := '';
  694.   pasfilename := '';
  695.  
  696.   for i := 1 to paramCount do
  697.     if copy(paramStr(i), 1, 1)='/' then
  698.       if upper(paramStr(i))='/V' then
  699.         verbose := true
  700.       else if upper(paramStr(i))='/D' then
  701.         debug := true
  702.       else
  703.         begin
  704.           writeln(invalid_option, paramStr(i));
  705.           halt(1);
  706.         end
  707.     else if yfilename='' then
  708.       yfilename := addExt(upper(paramStr(i)), 'Y')
  709.     else if pasfilename='' then
  710.       pasfilename := addExt(upper(paramStr(i)), 'PAS')
  711.     else
  712.       begin
  713.         writeln(illegal_no_args);
  714.         halt(1);
  715.       end;
  716.  
  717.   if yfilename='' then
  718.     begin
  719.       writeln(illegal_no_args);
  720.       halt(1);
  721.     end;
  722.  
  723.   if pasfilename='' then pasfilename := root(yfilename)+'.PAS';
  724.   lstfilename := root(yfilename)+'.LST';
  725.  
  726.   (* open files: *)
  727.  
  728.   assign(yyin, yfilename);
  729.   assign(yyout, pasfilename);
  730.   assign(yylst, lstfilename);
  731.  
  732.   reset(yyin);    if ioresult<>0 then fatal(cannot_open_file+yfilename);
  733.   rewrite(yyout); if ioresult<>0 then fatal(cannot_open_file+pasfilename);
  734.   rewrite(yylst); if ioresult<>0 then fatal(cannot_open_file+lstfilename);
  735.  
  736.   (* search code template in current directory, then on path where Yacc
  737.      was executed from: *)
  738.   codfilename := 'YYPARSE.COD';
  739.   assign(yycod, codfilename);
  740.   reset(yycod);
  741.   if ioresult<>0 then
  742.     begin
  743.       codfilename := upper(path(paramStr(0)))+'YYPARSE.COD';
  744.       assign(yycod, codfilename);
  745.       reset(yycod);
  746.       if ioresult<>0 then fatal(cannot_open_file+codfilename);
  747.     end;
  748.  
  749.   (* parse source grammar: *)
  750.  
  751.   write('parse ... ');
  752.  
  753.   lno := 0; cno := 1; line := '';
  754.  
  755.   next_section;
  756.   if debug then writeln(yyout, '{$define yydebug}');
  757.  
  758.   if yyparse=0 then
  759.     { done }
  760.   else if yychar=0 then
  761.     error(unexpected_eof)
  762.   else
  763.     error(syntax_error);
  764.  
  765.   if errors=0 then writeln('DONE');
  766.  
  767.   (* close files: *)
  768.  
  769.   close(yyin); close(yyout); close(yylst); close(yycod);
  770.  
  771.   (* print statistics: *)
  772.  
  773.   if errors>0 then
  774.     writeln( lno, ' lines, ',
  775.              errors, ' errors found.' )
  776.   else
  777.     begin
  778.       writeln( lno, ' lines, ',
  779.                n_rules-1, '/', max_rules-1, ' rules, ',
  780.                n_states, '/', max_states, ' s, ',
  781.                n_items, '/', max_items, ' i, ',
  782.                n_trans, '/', max_trans, ' t, ',
  783.                n_redns, '/', max_redns, ' r.');
  784.       if shift_reduce>0 then
  785.         writeln(shift_reduce, ' shift/reduce conflicts.');
  786.       if reduce_reduce>0 then
  787.         writeln(reduce_reduce, ' reduce/reduce conflicts.');
  788.       if never_reduced>0 then
  789.         writeln(never_reduced, ' rules never reduced.');
  790.     end;
  791.  
  792.   if warnings>0 then writeln(warnings, ' warnings.');
  793.  
  794.   writeln( n_bytes, '/', max_bytes, ' bytes of memory used.');
  795.  
  796.   (* terminate: *)
  797.  
  798.   if errors>0 then
  799.     begin
  800.       erase(yyout);
  801.       if ioresult<>0 then ;
  802.     end;
  803.  
  804.   if file_size(lstfilename)=0 then
  805.     erase(yylst)
  806.   else
  807.     writeln('(see ', lstfilename, ' for more information)');
  808.  
  809.   halt(errors);
  810.  
  811. end(*Yacc*).
  812.